perm filename READX.F4[EMS,LCS] blob sn#722190 filedate 1983-08-02 generic text, type T, neo UTF8
C*** CALLED BY TRANSF.F4 *********

	SUBROUTINE READX(N)
C  READS IN TWO FILES FOR TRANSFORMATION
	IMPLICIT INTEGER (X-Z)
	DIMENSION RN(3)
C  RN WILL HOLD FILE NAMES
	COMMON /A/X1(800),Y1(800),Z1(800),K1
	COMMON /B/X2(800),Y2(800),Z2(800),K2
	COMMON /C/X3(800),Y3(800),Z3(800),K3
1	FORMAT(' TYPE FILE NAME  '$)
2	FORMAT(A5)
3	FORMAT(4I)
	WRITE(5,1)
	READ(5,2)RN(N)
	NUM=1
	REWIND NUM
	CALL IFILE(NUM,RN(N))
	GO TO (10,20),N
C  K1 AND K2 WILL HOLD TOTAL OF POINTS.
10	K1=1
100	READ(NUM,3,END=12)K,X1(K1),Y1(K1),Z1(K1)
	K1=K1+1
	GO TO 100
12	K1=K1-1
	RETURN
20	K2=1
200	READ(NUM,3,END=11)K,X2(K2),Y2(K2),Z2(K2)
	K2=K2+1
	GO TO 200
11 	K2=K2-1
	END
 
	SUBROUTINE REVERS
C  REVERSES A AND B DATA. B MUST BE GREATER
	COMMON /A/X1(800),Y1(800),Z1(800),K1
	COMMON /B/X2(800),Y2(800),Z2(800),K2
	COMMON /C/X3(800),Y3(800),Z3(800),K3
	DO 1 K=1,K1
	X3(K)=X1(K)
	Y3(K)=Y1(K)
1	Z3(K)=Z1(K)
	K3=K1
	DO 27 K=1,K2
	X1(K)=X2(K)
	Y1(K)=Y2(K)
27	Z1(K)=Z2(K)
	K1=K2
	DO 3 K=1,K3
	X2(K)=X3(K)
	Y2(K)=Y3(K)
3	Z2(K)=Z3(K)
	K2=K3
	END

	SUBROUTINE FINDO(J,JOUT)
	DIMENSION J(1)
	DO 1 K=2,JOUT
1	IF(J(K).NE.0)GO TO 2
2	JOUT=K-1
C  TOTAL POINTS IN OUTLINE
	END

	SUBROUTINE OUTPUT
	IMPLICIT INTEGER (X-Z)
	COMMON /A/X1(800),Y1(800),Z1(800),K1
	COMMON /B/X2(800),Y2(800),Z2(800),K2
	COMMON /C/X3(800),Y3(800),Z3(800),K3
1	FORMAT(' TYPE OUTPUT FILE NAME  '$)
2	FORMAT(A5)
	TYPE 1
	ACCEPT 2,NAM
	IF(NAM.NE.'DPY')GO TO 20
3	FORMAT(3I4,I2,3X,3I4,I2,3X,3I4,I2,3X,3I4,I2)
	J=K3/4+1
	DO 4 K=1,J
	L=K+J
	M=K+J+J
	N=K+J+J+J
	TYPE 3,K,X3(K),Y3(K),Z3(K),L,X3(L),Y3(L),Z3(L),
	3 M,X3(M),Y3(M),Z3(M),N,X3(N),Y3(N),Z3(N)
4	CONTINUE
	PAUSE
20	CALL OFILE(1,NAM)
	K1=0
	DO 21 K=1,K3
	IF(Z3(K).NE.0)GO TO 28
C LOOK FOR REDUNDANT POINTS
	J=X3(K)
	IF(J.EQ.X3(K+1).AND.J.EQ.X3(K+2))GO TO 21
	J=Y3(K)
	IF(J.EQ.Y3(K+1).AND.J.EQ.Y3(K+2))GO TO 21
28	K1=K1+1
	X1(K1)=X3(K)
	Y1(K1)=Y3(K)
	Z1(K1)=Z3(K)
21	CONTINUE
22	FORMAT(3I4,I2)
	DO 25 K=1,340
	IF(K.LT.320)GO TO 25
	IF(Z1(K).NE.0)GO TO 200
25	WRITE(1,22)K,X1(K),Y1(K),Z1(K)
200	END FILE 1
	NAM=NAM+2
C  BE SURE TO USE 5-LETTER NAME ONLY.
	CALL OFILE(1,NAM)
	M=0
	N=K
	DO 23 K=N,K1
	M=M+1
23	WRITE(1,22)M,X1(K),Y1(K),Z1(K)
	END FILE 1
	END